﻿Attribute VB_Name = "模块1"
'处理文件名中日期所用到的变量
Dim date1 As Date, datestr As String, nday As String
'处理班报所用到的变量
Dim bfname As String, b1data(23) As Single, b2data(23) As Single, b3data(23) As Single, b As Integer
Dim bsheetname As String, v5s As Single, v6s As Single, x5s As Single, x6s As Single
'处理日报所用到的变量
Dim l As Integer, j As Integer, sheetname As String, ldata(17) As String
Dim fname As String     ', pth As String
'未打开的报表文件提示信息变量
Dim m1 As String, m2 As String, m3 As String, md As String, CalCmdBtn As Boolean

Sub 班报及日报系列总平均()
Attribute 班报及日报系列总平均.VB_Description = "2009-2-14"
Attribute 班报及日报系列总平均.VB_ProcData.VB_Invoke_Func = " \n14"
'=================================================================
' 模块名称：24小时平均电压等计算模块
' 描述：…
' 作者：Bay
' 创建时间：2009 年2 月14 日
' 修改时间：2009 年3 月03 日
' 版本：1.x
'1.2功能完善
'1.3更改显示界面为图像表格
'1.4添加自动更改日期
'1.5添加程序说明
'1.6添加班报表数据显示(重新设计数据处理方式),改正处理班报表Bug
'=================================================================
Application.ScreenUpdating = False
Windows.Application.Visible = False
'初始化日期变量
If TimeRange() Then
date1 = Now() - 1
nday = "昨天"
Else
date1 = Now()
nday = "今天"
End If
datestr = Format(date1, "yyyymmdd")
'初始化班报所用到的变量
ChDir "C:\Documents and Settings\Administrator\My Documents\b"
'bpth = "C:\Documents and Settings\Administrator\My Documents\b\"
bfname = "B0x_xxxxxxxx_Bx_Def0.xls"
bsheetname = "ship_report0"
CalCmdBtn = False   '计算按钮初始状态
'处理数据
Mid(bfname, 5, 8) = datestr
SubmitData1
SubmitData2
SubmitData3
SubmitDatad
If CalCmdBtn = False Then
    UserForm1.CommandButton1.Visible = True
End If
'屏幕显示
If m1 <> "" Or m2 <> "" Or m3 <> "" Or md <> "" Then
    nouse = MsgBox(m1 & Chr(13) & m2 & Chr(13) & m3 & Chr(13) & md, 64, "未打开的报表文件提示窗口")
End If
With UserForm1
    .Label25.Caption = CStr(Format(date1, "m月d日"))
    .Show modeless
End With
Workbooks.Close
Application.ScreenUpdating = True
'    Windows.Application.Visible = True
End Sub

'-------------------------------处理日报数据--------------------------------------
Sub SubmitDatad()
'初始化日报所用到的数据和变量
    ChDir "C:\Documents and Settings\Administrator\My Documents\d"
'    pth = "C:\Documents and Settings\Administrator\My Documents\d\"
    fname = "dD0x_xxxxxxxx_Def0.xls"
    sheetname = "day_report0"
    Mid(fname, 6, 8) = datestr
    l = 0
'打开日报文件（6个）
    For i = 1 To 6
        Mid(fname, 4, 1) = CStr(i)
        If ExistFile(fname) Then
            Workbooks.Open Filename:= _
            fname
        Else:
            md = "§未找到" & CStr(Format(date1, "m月d日(")) & nday & ")的日报文件！"
        Exit Sub
        End If
    Next i
'循环读取文件依次将需要数据存入数组
    For i = 1 To 6
        Mid(fname, 4, 1) = CStr(i)
        Workbooks(fname).Activate
            ldata(l) = Format(Excel.Worksheets(sheetname).Cells(52, 5).Value, "0.000#")             '平均电压
            ldata(l + 1) = Format(Excel.Worksheets(sheetname).Cells(52, 16).Value, "0.000#;;0")     'AE次数
            ldata(l + 2) = Excel.Worksheets(sheetname).Cells(52, 15).Text                           'AE持续时间
            l = l + 3
'        Workbooks(fname).Close SaveChanges:=False
    Next i
    Workbooks.Close
'显示日报数据
    With UserForm1
        .Label1.Caption = ldata(0)
        .Label2.Caption = ldata(1)
        .Label3.Caption = ldata(2)  '51区,1#
        .Label4.Caption = ldata(6)
        .Label5.Caption = ldata(7)
        .Label6.Caption = ldata(8)  '52区,3#
        .Label7.Caption = ldata(12)
        .Label8.Caption = ldata(13)
        .Label9.Caption = ldata(14)  '53区,5#
        .Label10.Caption = ldata(3)
        .Label11.Caption = ldata(4)
        .Label12.Caption = ldata(5)    '61区,2#
        .Label13.Caption = ldata(9)
        .Label14.Caption = ldata(10)
        .Label15.Caption = ldata(11)    '62区,4#
        .Label16.Caption = ldata(15)
        .Label17.Caption = ldata(16)
        .Label18.Caption = ldata(17)    '63区,6#
         ldata(2) = AEtimeConv(ldata(2))
         ldata(8) = AEtimeConv(ldata(8))
         ldata(14) = AEtimeConv(ldata(14))
         ldata(5) = AEtimeConv(ldata(5))
         ldata(11) = AEtimeConv(ldata(11))
         ldata(17) = AEtimeConv(ldata(17))
                  
         .Label19.Caption = ldata(2)
         .Label20.Caption = ldata(8)
         .Label21.Caption = ldata(14)
         .Label22.Caption = ldata(5)
         .Label23.Caption = ldata(11)
         .Label24.Caption = ldata(17)
            With .TextBox1
                .ControlTipText = Application.WorksheetFunction _
                    .Average(ldata(0), ldata(3), ldata(6), ldata(9), ldata(12), ldata(15))
                .Text = Format(.ControlTipText, "#0.000")
            End With
            With .TextBox2
                .ControlTipText = Application.WorksheetFunction _
                    .Average(ldata(1), ldata(4), ldata(7), ldata(10), ldata(13), ldata(16))
                .Text = Format(.ControlTipText, "#0.000")
            End With
            With .TextBox3
                .ControlTipText = Application.WorksheetFunction _
                    .Average(ldata(2), ldata(5), ldata(8), ldata(11), ldata(14), ldata(17))
                .Text = Format(.ControlTipText, "0.秒")
            End With
    End With
End Sub

'处理一班上报数据
Sub SubmitData1()
Mid(bfname, 15, 1) = "1"
v5s = 0
v6s = 0
x5s = 0
x6s = 0
b = 0   '初始化班报数组计数器
'处理1班报文件名
    For i = 1 To 6
        Mid(bfname, 3, 1) = CStr(i)
        If ExistFile(bfname) Then
            Workbooks.Open Filename:=bfname
            b1data(b) = Excel.Worksheets(bsheetname).Cells(52, 5).Value
            b1data(b + 1) = Excel.Worksheets(bsheetname).Cells(52, 9).Value
            b = b + 4
        Else: m1 = "☆ 未找到" & nday & "一班的班报表文件！"
            CalCmdBtn = True
        Exit Sub
        End If
    Next i
    v5s = b1data(0) + b1data(8) + b1data(16)     '五车间
    x5s = b1data(1) + b1data(9) + b1data(17)
    v6s = b1data(4) + b1data(12) + b1data(20)    '六车间
    x6s = b1data(5) + b1data(13) + b1data(21)
    With UserForm1
        .Label26.Caption = fmt(b1data(0))   '51区1#(一班报表数据)
        .Label27.Caption = fmt(b1data(1))
        .Label30.Caption = fmt(b1data(8))   '52 ,3#
        .Label31.Caption = fmt(b1data(9))
        .Label34.Caption = fmt(b1data(16))   '53 ,5#
        .Label35.Caption = fmt(b1data(17))
        .Label38.Caption = fmt(b1data(4))  '61 ,2#
        .Label39.Caption = fmt(b1data(5))
        .Label42.Caption = fmt(b1data(12))  '62 ,4#
        .Label43.Caption = fmt(b1data(13))
        .Label46.Caption = fmt(b1data(20))  '63 ,6#
        .Label47.Caption = fmt(b1data(21))
        .TextBox4.Value = Format(v5s / 3, "#0.000")
        .TextBox5.Value = Format(x5s / 3, "#0.000")
        .TextBox6.Value = Format(v6s / 3, "#0.000")
        .TextBox7.Value = Format(x6s / 3, "#0.000")
    End With
    Workbooks.Close
End Sub

'处理二班上报数据
Sub SubmitData2()
Mid(bfname, 15, 1) = "2"
v5s = 0
v6s = 0
x5s = 0
x6s = 0
b = 0
'处理2班报文件名
    For i = 1 To 6
        Mid(bfname, 3, 1) = CStr(i)
        If ExistFile(bfname) Then
            Workbooks.Open Filename:=bfname
            b2data(b) = Excel.Worksheets(bsheetname).Cells(52, 5).Value
            b2data(b + 1) = Excel.Worksheets(bsheetname).Cells(52, 9).Value
            b = b + 4
        Else: m2 = "☆ 未找到" & nday & "二班的班报表文件！"
            CalCmdBtn = True
        Exit Sub
        End If
    Next i
    v5s = b2data(0) + b2data(8) + b2data(16)     '五车间
    x5s = b2data(1) + b2data(9) + b2data(17)
    v6s = b2data(4) + b2data(12) + b2data(20)    '六车间
    x6s = b2data(5) + b2data(13) + b2data(21)
    With UserForm1
        .Label50.Caption = fmt(b2data(0))   '51区1#(二班报表数据)
        .Label51.Caption = fmt(b2data(1))
        .Label54.Caption = fmt(b2data(8))   '52 ,3#
        .Label55.Caption = fmt(b2data(9))
        .Label58.Caption = fmt(b2data(16))  '53 ,5#
        .Label59.Caption = fmt(b2data(17))
        .Label62.Caption = fmt(b2data(4))   '61 ,2#
        .Label63.Caption = fmt(b2data(5))
        .Label66.Caption = fmt(b2data(12))  '62 ,4#
        .Label67.Caption = fmt(b2data(13))
        .Label70.Caption = fmt(b2data(20))  '63 ,6#
        .Label71.Caption = fmt(b2data(21))
        .TextBox8.Value = Format(v5s / 3, "#0.000")
        .TextBox9.Value = Format(x5s / 3, "#0.000")
        .TextBox10.Value = Format(v6s / 3, "#0.000")
        .TextBox11.Value = Format(x6s / 3, "#0.000")
    End With
    Workbooks.Close
End Sub

'处理三班上报数据
Sub SubmitData3()
Mid(bfname, 15, 1) = "3"
v5s = 0
v6s = 0
x5s = 0
x6s = 0
b = 0
'处理3班报文件名
For i = 1 To 6
        Mid(bfname, 3, 1) = CStr(i)
        If ExistFile(bfname) Then
            Workbooks.Open Filename:=bfname
            b3data(b) = Excel.Worksheets(bsheetname).Cells(52, 5).Value
            b3data(b + 1) = Excel.Worksheets(bsheetname).Cells(52, 9).Value
            b = b + 4
        Else: m3 = "☆ 未找到" & nday & "三班的班报表文件！"
            CalCmdBtn = True
        Exit Sub
        End If
    Next i
    v5s = b3data(0) + b3data(8) + b3data(16)     '五车间
    x5s = b3data(1) + b3data(9) + b3data(17)
    v6s = b3data(4) + b3data(12) + b3data(20)    '六车间
    x6s = b3data(5) + b3data(13) + b3data(21)
    With UserForm1
        .Label74.Caption = fmt(b3data(0))   '51区1#(三班报表数据)
        .Label75.Caption = fmt(b3data(1))
        .Label78.Caption = fmt(b3data(8))   '52 ,3#
        .Label79.Caption = fmt(b3data(9))
        .Label82.Caption = fmt(b3data(16))  '53 ,5#
        .Label83.Caption = fmt(b3data(17))
        .Label86.Caption = fmt(b3data(4))   '61 ,2#
        .Label87.Caption = fmt(b3data(5))
        .Label90.Caption = fmt(b3data(12))  '62 ,4#
        .Label91.Caption = fmt(b3data(13))
        .Label94.Caption = fmt(b3data(20))  '63 ,6#
        .Label95.Caption = fmt(b3data(21))
        .TextBox12.Value = Format(v5s / 3, "#0.000")
        .TextBox13.Value = Format(x5s / 3, "#0.000")
        .TextBox14.Value = Format(v6s / 3, "#0.000")
        .TextBox15.Value = Format(x6s / 3, "#0.000")
    End With
    Workbooks.Close
End Sub

'效应时间转换函数
Private Function AEtimeConv(strAEtime As String) As Integer
Dim intMinutes As Integer, intSeconds As Integer, fAEtime As String
fAEtime = Format(strAEtime, "####00'00''")
intSeconds = Val(Right(fAEtime, 4))
intMinutes = Val(Left(Right(fAEtime, 7), 3))
AEtimeConv = intMinutes * 60 + intSeconds
End Function

'判断文件存在函数
Function ExistFile(fnme As String) As Boolean
On Error Resume Next
ExistFile = (Dir(fnme) <> "")
End Function

'判断时间
Function TimeRange() As Boolean
On Error Resume Next
Dim nowtime
nowtime = Time
If 0 <= Hour(nowtime) And Hour(nowtime) < 8 Then
TimeRange = True
Else: TimeRange = False
End If
End Function
'格式化数据
Function fmt(fd) As String
fmt = Format(fd, "#0.000")
End Function
